home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / DTP / DTP_TEX / H220.ZIP / HP2TEX.ZIP / HP2TEX.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-01  |  27KB  |  820 lines
  1. {HP2TEX - CONVERT HP SOFT FONT FILES TO TEX PL AND PXL FILES. (TurboPascal 3.0)
  2.  
  3. This program will read an HP soft font and generate two files
  4. useful to TeX users, a PL and a PXL file. In order to use the font
  5. in TeX, take the PL file and run PLTOTF (part of TeXware, ask your
  6. local wizard if this is meaningless to you). The PXL file may be useful
  7. if you have an obsolete driver. More likely you will need to run PXTOPK
  8. (also part of the TeXware distribution) to generate a packed PK file used by
  9. more modern drivers. If you require GF files, I'm afraid you are out of luck.
  10.  
  11. This program was written by David Strip, Albquerque NM with generous help from
  12. Dimitri L. Vulis of NYC. This program is copyrighted, and in keeping with the
  13. spirit of the TeX community, you are granted permission to copy and
  14. redistribute this program, so long as you provide the source along with any
  15. executable. In addition, you may not charge any fee in excess of the actual
  16. cost of the media and reasonable labor charges. This charge may not exceed
  17. $3.00 per disk plus shipping costs. This software may not be packaged together
  18. with any other software unless the complete package also meet the stated terms
  19. for redistribution. These terms apply to derivative codes as well. To put it
  20. simply, we are not making a profit on this code, and we won't allow you to
  21. either. Exemptions to these terms may be granted only by the authors, and must
  22. be in writing.
  23.  
  24. If you should modify this code in a useful way, we would be pleased to receive
  25. a copy of your efforts. An ambitious soul might try to add a capability to
  26. read the kerns from one of the CM font .pl files and 'scale' them as a first
  27. cut at kerns for the font being converted. We will also attempt to respond to
  28. bug reports. Bear in mind, however, that you didn't pay anything for this
  29. code.
  30.  
  31. We have already noted that certain fonts generated by glyphix appear to
  32. convert with a bad underscore character that is far too low. This is in fact
  33. how the underscore is encoded in the font, not an artifact of the conversion.
  34. Sorry, we are not planning to try to correct glyphix's error.
  35.  
  36. If you are pleased with what you got and want to return the favor, send us a
  37. disk with your favorite HP downloadable fonts, or anything else nice. Surprise
  38. us with goodies in our mailboxes!!!! 
  39.  
  40. February 29, 1988
  41.  
  42. David Strip (arpanet: drstrip@sandia-2.arpa
  43.   uucp: ....(ucbvax, cmu!rice, ihnp4!lanl, gatech)!unmvax!intvax!drstrip)
  44.              Snail mail:
  45.                 431 Camino de la Sierra NE
  46.                 Albuquerque, NM 87123
  47.  
  48. Dimitri L. Vulis (bitnet: dlv@cunyvms1.bitnet
  49.              arpanet: dlv%cunyvms1.bitnet@cunyvm.cuny.edu)
  50.              Snail mail:
  51.                 529 W. 111 St. #61
  52.                 New York, New York 10025-1943
  53.  
  54. (c) Copyright 1988, David Strip and Dimitri L. Vulis, all rights reserved.
  55.  
  56.  
  57. ------------------------------------------------------------------------
  58. Change History:
  59.  
  60. V. 1.0  Original Release, February, 1988
  61.  
  62. }
  63.  
  64. program hp2tex;
  65.  
  66. type
  67.   s=string[255];
  68.   fname = string[60];
  69.   m_string = string[80];
  70.   fontheader = record
  71.      len: integer;
  72.      filler: byte;
  73.      font_type: byte;
  74.      filler2: integer;
  75.      baseline_pos: integer;
  76.      cell_width: integer;
  77.      cell_height: integer;
  78.      orientation: byte;
  79.      fixed: byte;
  80.      symbol_set: integer;
  81.      pitch: integer;
  82.      height: integer;
  83.      filler3: integer;
  84.      filler4: byte;
  85.      style: byte;
  86.      stroke: byte;
  87.      typeface: byte;
  88.      end;
  89.  
  90.    char_header = record
  91.      four: byte;
  92.      zero1: byte;
  93.      fourteen: byte;
  94.      one: byte;
  95.      orientation: byte;
  96.      zero2: byte;
  97.      left_offset: integer;
  98.      top_offset: integer;
  99.      char_width: integer;
  100.      char_height: integer;
  101.      delta_x: integer;
  102.      end;
  103.  
  104.   word = record case boolean of  {simulated longint}
  105.      false: (low_half, high_half: integer);
  106.      true: (b0,b1,b2,b3: byte);
  107.      end;
  108.  
  109.   dir_entry = record
  110.      pxl_width: integer;  {dots}
  111.      pxl_height: integer; {dots}
  112.      x_offset: integer;   {dots}
  113.      y_offset: integer;   {dots}
  114.      pointer: word;
  115.      tfm_width: word;     {fixes}
  116.      radix_width: integer;{radix points}
  117.      end;
  118.  
  119. const
  120.    pxlheader: word = (low_half:1001; high_half:0); {32-bit aligned}
  121.     {16-bit aligned files with header=1002 will be supported later}
  122.    zero: byte = 0;
  123.    zero_int: integer = 0;
  124.    zero_word: word = (low_half:0; high_half:0);
  125.  
  126.  
  127. var
  128.    hpfile: file;
  129.    pxlfile: file;
  130.    plfile: text;
  131.      
  132.    hpbuf: array[1..2048] of byte;
  133.    hpbufptr: integer;
  134.    hpbuflen: integer;
  135.      
  136.    pxlbuf: array[1..2048] of byte;
  137.    pxlbufptr: integer;
  138.  
  139.    c: byte;
  140.      
  141.    font1: fontheader;
  142.    char1: char_header;
  143.    pxl_dir: array[0..127] of dir_entry;
  144.  
  145.    char_code, char_len: integer;
  146.  
  147.    byte_width: integer;
  148.    extra_bytes: integer;
  149.  
  150.    pxlbyte: byte;
  151.    pxl_ptr: word;
  152.  
  153.    design_size:integer;
  154.    designsize: word;
  155.    magnification: word;
  156.    magn_scale: real; {1000/magnification}
  157.    dot_scale: real; {dots -> fixes}
  158.    radix_scale: real; {radix pts (1/4 dot) -> fixes}
  159.  
  160.  
  161.    filename: fname;
  162.    i,j,k,l,m,n:integer;
  163.    buffer: array[1..2048] of byte;
  164.  
  165. procedure die(w:s);
  166. begin
  167.    writeln(w);
  168.    writeln('File pos=',filepos(hpfile));
  169.    halt;
  170. end;
  171.  
  172. function getchar:byte;
  173.  
  174. begin
  175.   if hpbufptr>=hpbuflen then begin
  176.     blockread(hpfile, hpbuf, 2048, hpbuflen);
  177.     hpbufptr:=1;
  178.     getchar:=hpbuf[1];
  179.     end
  180.   else begin
  181.     hpbufptr:=hpbufptr+1;
  182.     getchar:=hpbuf[hpbufptr];
  183.     end;
  184.   end;
  185.  
  186. procedure putchar(c:byte);
  187. begin
  188.   pxlbuf[pxlbufptr]:=c;
  189.   if pxlbufptr=2048 then begin
  190.     blockwrite(pxlfile, pxlbuf, 2048);
  191.     pxlbufptr:=1;
  192.     end
  193.   else pxlbufptr:=pxlbufptr+1;
  194.   end;
  195.  
  196. procedure closeout(var outfile: file);
  197. begin
  198.   if pxlbufptr>1 then blockwrite(pxlfile, pxlbuf, pxlbufptr-1);
  199.   close(pxlfile);
  200.   end;
  201.  
  202.  
  203. procedure writea(var outfile: file; var t;i:integer);
  204. var
  205.    j:integer;
  206. begin
  207.    if i>2048 then die('Died writing an impossibly large character');
  208.    move(t,buffer,i);
  209.    for j:=1 to i do
  210.       putchar(buffer[j]);
  211.    end;
  212.  
  213. {This procedure is not needed if someone ports this code to a
  214.  Bigendian machine. Just remove this stuff snd replace the calls to it
  215.  by just writea.}
  216.  
  217. procedure writear(var outfile: file; var t;i:integer); {write reversed}
  218. var
  219.    j:integer;
  220. begin
  221.    if i>2048 then die('Died writing an impossibly large character');
  222.    move(t,buffer,i);
  223.    for j:=i downto 1 do
  224.       putchar(buffer[j]);
  225.      end;
  226.  
  227.  
  228. procedure swapbytes(var x:integer);
  229. {this procedure is not needed if someone ports this code to a
  230.  Bigendian machine. Just remove this stuff as well as the calls to it.}
  231. var x1:record case boolean of
  232. 0: (i1,i2: byte);
  233. 1: (i3: integer);
  234. end;
  235. begin
  236. x1.i3:=x;
  237. x1.i1:=x1.i1 xor x1.i2;
  238. x1.i2:=x1.i1 xor x1.i2;
  239. x1.i1:=x1.i1 xor x1.i2;
  240. x:=x1.i3
  241. end;
  242.  
  243.  
  244.  
  245. procedure readn(var infile: file; var num: integer; x:char);
  246.      {read number, expressed in chars from infle, convert, put it in num}
  247. var c:byte;
  248. begin
  249.    num:=0;
  250.    c:=getchar;
  251.    if not (c in [ord('0')..ord('9')]) then die('Number expected');
  252.    repeat
  253.    num:=num*10+c-ord('0');
  254.    c:=getchar;
  255.    until not (c in [ord('0')..ord('9')]);
  256.    if c<>ord(x) then die(x+' expected');
  257.    end;
  258.  
  259. procedure pchar(i:byte);
  260. begin
  261.    case i of
  262. 0:      write('NULL character');
  263. 7:      write('BELL character');
  264. 8:      write('BACKSPACE character');
  265. 9:      write('TAB character');
  266. 10:     write('LINE FEED character');
  267. 12:     write('FORM FEED character');
  268. 13:     write('CARRIAGE RETURN character');
  269. 26:     write('END-OF-FILE character');
  270. 27:     write('ESCAPE character');
  271. 32:     write('SPACE character');
  272. 33..126:write('``',chr(i),'''''');
  273. 127:    write('DEL');
  274.    else write('chr(',i:0,')'); {A control character, or >127}
  275.    end;
  276. end;
  277.  
  278. function expect(var infile: file; w:s): boolean;
  279. begin
  280.    expect:=true; {innocent until proven guilty}
  281.    for j:=1 to length(w) do begin
  282.       c:=getchar;
  283.       if chr(c)<>w[j] then begin
  284.          pchar(ord(w[j]));
  285.          write(' expected but found ');
  286.          pchar(c);
  287.          expect:=false;
  288.          exit; {for}
  289.          end; {if}
  290.       end; {for j}
  291. end;
  292.  
  293. procedure reada(var infile: file; var t;i:integer);
  294. var
  295.    j:integer;
  296.    x:array[0..2048] of byte;
  297. begin
  298.    if i>2048 then
  299.     die('Died reading an impossibly large character or font header');
  300.    for j:=0 to i-1 do
  301.       x[j]:=getchar;
  302.    move(x,t,i);
  303.    end;
  304.  
  305.  
  306. procedure open_untyped_file(var infile: file; filename,dft: fname; r_w: char;
  307.                      message: m_string);
  308. begin
  309.    repeat
  310.       while filename='' do begin
  311.          write(message);
  312.          readln(filename);
  313.          end;
  314.       i:=ord(filename[0]); if i>4 then i:=4;
  315.       if pos('.',copy(filename,ord(filename[0])-i+1,i))=0 then
  316.         filename:=filename+'.'+dft;
  317.       assign(infile,filename);
  318.       filename:='';
  319.    {$I-}
  320.       if r_w='w' then rewrite(infile,1) else reset(infile,1);
  321.    {$I+}
  322.       until ioresult=0;
  323.    end;
  324.  
  325. procedure open_text_file(var infile: text; filename,dft: fname; r_w: char;
  326.                      message: m_string);
  327. begin
  328.    repeat
  329.       while filename='' do begin
  330.          write(message);
  331.          readln(filename);
  332.          end;
  333.       i:=ord(filename[0]); if i>4 then i:=4;
  334.       if pos('.',copy(filename,ord(filename[0])-i+1,i))=0 then
  335.         filename:=filename+'.'+dft;
  336.       assign(infile,filename);
  337.       filename:='';
  338.    {$I-}
  339.       if r_w='w' then rewrite(infile) else reset(infile);
  340.    {$I+}
  341.       until ioresult=0;
  342.    end;
  343.  
  344. procedure set_tfm_width(radix: integer; var fixes: word);
  345.  
  346. {the tfm width in .pxl file is expressed in 'fixes' which are 1/2^20 of
  347. the design size. To get this, divide the width in radix points by the
  348. design size (in points), then multiply by 2^20. radix_scale is the
  349. precomputed conversion factor.}
  350.  
  351. var
  352.    real_fixes: real;
  353. begin
  354. {float everything and divide. If we had longints, we'd say:
  355.  fixes:=trunc(2^20*radix*radix_scale);
  356. Here we lose the lowest bit, but it does not matter since the real
  357.  arithmetic makes the entire low byte meaningless}
  358.    real_fixes:=radix*radix_scale*16;
  359.    fixes.high_half:=trunc(real_fixes);
  360.    fixes.low_half:=trunc((real_fixes-fixes.high_half)*32768.0) shl 1;
  361.    end;
  362.  
  363. procedure skipjunk(num: integer);
  364. {Skip junk bytes. However, some vendors (notably HP itself) hide certain
  365.  info (e.g. a copyright notice) in these junk bytes, so we will display
  366.  whatever ASCII we find}
  367. var f:boolean;
  368. begin
  369.   write('Skipping ',num,' bytes of junk');
  370.   {Amazingly, this seems to work faster than b4---seek flushes buffers!}
  371.   f:=true;
  372.   for i:=1 to num do begin
  373.      c:=getchar;
  374.      if c in [ord(' ')..126] then begin
  375.         if f then write(' [');
  376.         write(chr(c));
  377.         f:=false;
  378.         end
  379.      else begin
  380.         if not f then write(']');
  381.         f:=true;
  382.         end;
  383.      end;
  384.   if not f then write(']');
  385.   writeln;
  386.   end;
  387.  
  388.  
  389. procedure read_fontheader;
  390. var hdr_len: integer;
  391. begin
  392.    if not expect(hpfile,chr(27)+')s') then
  393.       die('escape sequence for font header not found');
  394.    readn(hpfile,hdr_len,'W'); {size of font header}
  395.    hdr_len:=hdr_len-26;
  396.    if hdr_len<0 then
  397.       die('font header is too short');
  398.    reada(hpfile,font1,26);
  399.    writeln('Font characteristics:');
  400.    with font1 do begin
  401.      swapbytes(cell_width);
  402.      swapbytes(cell_height);
  403.      swapbytes(pitch);
  404.      swapbytes(height);
  405.      writeln(' Cell width =',cell_width,' dots');
  406.      writeln(' Cell height=',cell_height,' dots');
  407.      writeln(' Font Pitch =',pitch,'/4 dots');
  408.      writeln(' Font Height   =',height,'/4 dots');
  409.      writeln(' Stroke Weight =',stroke+7,' (0..14, 7 normal)'); {signed}
  410.      write('Font type: ');
  411.      case font_type of
  412.         0: write('7 bit');
  413.         1: write('8 bit HP');
  414.         2: write('8 bit IBM');
  415.         else die('7/8 bit byte not 0,1 or 2');
  416.         end; writeln;
  417.      write('Font style: ');
  418.      case style of
  419.         0: write('upright');
  420.         1: write('slanted');
  421.         else write('neither upright nor slanted ',style);
  422.         end; writeln;
  423.      write('Orientation: ');
  424.      case orientation of
  425.         0:  write('portrait');
  426.         1:  die  ('landscape---not supported');
  427. {Landscape fonts have rasters sideways. Since it's highly unlikely
  428. that someone has the landscape but not the portrait version of a
  429. font, it just isn't worthwhile to rotate the raster}
  430.         else die('orientation byte not 0 or 1');
  431.         end; {orientation} writeln;
  432.      write('Fixed/Prop: ');
  433.      case fixed of
  434.         0: write('fixed');
  435.         1: write('proportional');
  436.         else die('proportional byte not 0 or 1');
  437.         end;
  438.      writeln;
  439.      write('Symbol set: (The hex is the PCL value): ');
  440.      case symbol_set of
  441.         $0100: write(' 0A  Math 7');
  442.         $0200: write(' 0B  HP Line Draw');
  443.         $0300: write(' 0C  Block characters');
  444.         $0400: write(' 0D  Norwegian v1, ISO #60');
  445.         $2400: write(' 1D  Norwegian v2, ISO #61');
  446.         $0500: write(' 0E  HP Roman Ext');
  447.         $2500: write(' 1E  United Kingdom, ISO #4');
  448.         $0600: write(' 0F  French, ISO #25');
  449.         $2600: write(' 1F  French, ISO #69');
  450.         $0700: write(' 0G  HP German');
  451.         $2700: write(' 1G  German, ISO #21');
  452.         $0701: write(' 8G  HP Greek 8');
  453.         $0800: write(' 0H  HP Hebrew 7');
  454.         $0801: write(' 8H  HP Hebrew 8');
  455.         $0900: write(' 0I  Italian, ISO #21');
  456.         $0A00: write(' 0J  Currently Open');
  457.         $0B00: write(' 0K  JIS ASCII, ISO #14');
  458.         $2B00: write(' 1K  HP Katakana');
  459.         $4B00: write(' 2K  Chinese, ISO #57');
  460.         $0A01: write(' 8K  HP Kana 8');
  461.         $2B01: write(' 9K  HP Korean 8');
  462.         $0D01: write(' 8M  HP Math 8');
  463.         $0E00: write(' 0N  ECMA-94 Latin 1, ISO #100');
  464.         $2E00: write(' 1N  ECMA-94 Latin 2, ISO #101');
  465.         $4E00: write(' 2N  ECMA-94 Latin 3, ISO #109');
  466.         $6E00: write(' 3N  ECMA-94 Latin 4, ISO #110');
  467.         $8E00: write(' 4N  ECMA Latin/Greek');
  468.         $AE00: write(' 5N  ECMA Latin/Cyrillic');
  469.         $CE00: write(' 6N  ECMA Latin/Arabic');
  470.         $0F00: write(' 00  OCR-A');
  471.         $2F00: write(' 10  OCR-B');
  472.         $4F00: write(' 20  OCR-M');
  473.         $1000: write(' 0P  APL (typewriter paired)');
  474.         $3000: write(' 1P  APL (bit paired)');
  475.         $1100: write(' 0Q  Reserved for Specials');
  476.         $1200: write(' 0R  Cyrillic ASCII');
  477.         $3200: write(' 1R  Cyrillic');
  478.         $1300: write(' 0S  Swedish for Names, ISO #11');
  479.         $3300: write(' 1S  HP Spanish');
  480.         $5300: write(' 2S  Spanish, ISO #11');
  481.         $7300: write(' 3S  Swedish, ISO #10');
  482.         $9300: write(' 4S  Portugese, ISO #16');
  483.         $B300: write(' 5S  Portugese, ISO #84');
  484.         $D300: write(' 6S  Portugese, ISO #85');
  485.         $1401: write(' 8T  HP Turkish 8');
  486.         $1500: write(' 0U  ANSI US ASCII, ISO #6');
  487.         $3500: write(' 1U  HP Legal');
  488.         $5500: write(' 2U  Intl ref version, ISO #2');
  489.         $B500: write(' 5U  HP HPL Language set');
  490.         $1501: write(' 8U  HP Roman 8');
  491.         $5501: write(' 10U IBM PC Set (US version)');
  492.         $7501: write(' 11U IBM PC Set (Denmark/Norway version)');
  493.         $9501: write(' 11U IBM PC Set');
  494.         $F501: write(' 15U HP Pi font');
  495.         $1600: write(' 0V  Arabic (Mackay)');
  496.         $1601: write(' 8V  HP Arabic 8');
  497.         $1900: write(' 0Y  3 of 9 bar code');
  498.         $3900: write(' 1Y  Indus 2 of 5 bar code');
  499.         $5900: write(' 2Y  Matrix 2 of 5 bar code');
  500.         $9900: write(' 4Y  Interleaved 2 of 5 bar code');
  501.         $B900: write(' 5Y  Coda bar code');
  502.         $D900: write(' 6Y  MSI/Plessey bar code');
  503.         $F900: write(' 7Y  Code II bar code');
  504.         $1901: write(' 8Y  UPC/EAN bar code');
  505.         else  write('Unknown symbol set ',symbol_set);
  506.         end;
  507.      writeln;
  508.      write('Typeface code: ');
  509.      case typeface of
  510.        0: write('Line printer');
  511.        1: write('Pica');
  512.        2: write('Elite');
  513.        3: write('Courier');
  514.        4: write('Helvetica');
  515.        5: write('Times Roman');
  516.        6: write('Gothic');
  517.        7: write('Script');
  518.        8: write('Prestige');
  519.        9: write('Caslon');
  520.       10: write('Orator');
  521.       11: write('Presentation');
  522.       14: write('Swiss 721');
  523.       15: write('Dutch 801');
  524.       17: write('Optima');
  525.       else write('Unknown Typeface code');
  526.       end; {typeface code} writeln;
  527.      end; {with}
  528. {
  529.  According to my HP docs, one should NOT put a copyright notice here.
  530.  These bytes have some values assigned to them which are not used but
  531.  will be used later. I think the best thing is to ignore them.
  532. }
  533.    if hdr_len>0 then skipjunk(hdr_len);
  534.    end;
  535.  
  536. procedure ask_for_magn_and_design_size;
  537. begin
  538. {It is often the case that a 12-point HP font is actually the same as the
  539.  10-point font scaled 1200. If this is the case, then you should tell the
  540.  program that the magnification was indeed 1200. If you are not sure what
  541.  is magnification and design size, just press enter in response to both
  542.  questions. }
  543.     magnification.high_half:=0;
  544.     magnification.low_half:=1000; {default}
  545.     writeln('Default magnification is 1000. If you are not sure what');
  546.     writeln('magnification and design size are, just press enter ');
  547.     writeln('in response to the next two questions.');
  548.     write  ('Press enter or type another magnification:');
  549.     readln (magnification.low_half);
  550.     magn_scale:=1000.0/magnification.low_half; {for multiplication}
  551. {Estimate TeX design size based on font height}
  552.     design_size:=trunc((font1.height*3+25)*magn_scale) div 50;
  553.     writeln('Suggested design size=',design_size,'pt (printer''s points)');
  554.     write  ('Press enter or type another design size: ');
  555.     readln (design_size);
  556.     designsize.high_half:=16*design_size; {This is what will be stored to the
  557.     .pxl file. It is a word measuring design size in fixes = 2^20
  558.     times actual size. Set the lower half to zero (in initialization)
  559.     and the high half to 2^4 times actual size.}
  560.     designsize.low_half:=0;
  561. {radix_scale is used to xlate radix points to fixes in set_tfm_widths
  562.  for the .pxl file. Explanation: 72.27 pt/in / 1200 radix/in.
  563.  the actual values in the next statement are from [72.27*100)/3]/[(1200*100)/3]
  564.  which gives nice integer values to use when we upgrade to TP4 with longints.}
  565.     radix_scale:=2409.0/design_size/40000.0*magn_scale;
  566.     dot_scale:=radix_scale*4;
  567.  end;
  568.  
  569.  
  570. procedure read_char(var char_code: integer);
  571. {
  572.  get all of character's data
  573.  save its width etc in pxl_dir
  574.  copy its raster to pxl file
  575. }
  576. begin
  577. {Get the char code and print message}
  578. if not expect(hpfile,chr(27)+'*c') then begin
  579.    char_code:=-1;
  580. {we don't die but gracefully exit}
  581.    writeln(' while looking for character specification sequence');
  582.    end
  583. else begin
  584.   readn(hpfile,char_code,'E');
  585.   if not char_code in [0..127] then
  586.     die('PXL file cannot handle characters outside 0..127');
  587.   write(' [',char_code,'] '); pchar(char_code);
  588.   {Now read the character header}
  589.   if not expect(hpfile,chr(27)+'(s') then
  590.      die('while looking for char header');
  591.   readn(hpfile,char_len,'W');
  592.   reada(hpfile,char1,16);
  593.   with char1,pxl_dir[char_code] do begin
  594.     if orientation<>font1.orientation then
  595.       die('orientation does not match');
  596.     swapbytes(left_offset);
  597.     swapbytes(top_offset);
  598.     swapbytes(char_width);
  599.     swapbytes(char_height);
  600.     swapbytes(delta_x);
  601.     {save the data in pxl array}
  602.     pxl_width:=char_width;
  603.     pxl_height:=char_height;
  604.     x_offset:= -left_offset;
  605.     y_offset:= top_offset;
  606.     pointer:=pxl_ptr;
  607.     if font1.fixed=1 then
  608.       radix_width:=delta_x
  609.     else
  610.       radix_width:=font1.pitch;
  611.     set_tfm_width(radix_width,tfm_width);
  612.     end; {with}
  613.   char_len:=char_len-16;
  614.   if (char1.char_width=0) or (char1.char_height=0) then begin {happens!}
  615.     if char_len>0 then skipjunk(char_len);
  616.     pxl_dir[char_code].pointer:=zero_word;
  617.     end
  618. {The pxl file is written in 4 byte words. The HP file is in bytes, with the
  619. high order bit of the first byte corresponding to the left upper pixel. Thus,
  620. we at least don't have to re-order bytes, since the h.o.bit of word 0 of the
  621. pxl file format is also the left-upper pixel. We do, however, have to pad out
  622. the row to a multiple of 4 bytes. And don't forget to save the WORD count to
  623. the pxl file, this is needed to fill in the font directory.}
  624.    else begin {copy rows}
  625.        byte_width:=(char1.char_width+7) shr 3{div 8}; {# bytes to read}
  626.        l:=byte_width and 3{mod 4};
  627.        if l>0 then
  628.          l:=byte_width+4-l {padding required}
  629.        else
  630.          l:=byte_width;    {no padding required}
  631.      for j:=byte_width+1 to l do
  632.         buffer[j]:=0; {the padding}
  633.      {copy pixels from hpfile to pxlfile, padding out the rows}
  634.      for i:=1 to char1.char_height do begin
  635.         reada(hpfile,buffer,byte_width);
  636.         writea(pxlfile,buffer,l);
  637.         char_len:=char_len-byte_width;
  638.         if char_len<0 then die('Raster too short');
  639.         end; {for i}
  640.      if char_len>0 then skipjunk(char_len);
  641.      {update pointer to pxlfile}
  642.      {the following kludge should be replaced if you have
  643.       longints (it won't even work in TP4, I believe)}
  644.      i:=((l shr 2 {div 4})*char1.char_height); {#word written}
  645.      {pxl_ptr:=pxl_ptr+i;}
  646.      inline(
  647.       $A1/>i                 {MOV AX,I}
  648.      /$01/06/>pxl_ptr        {ADD pxl_ptr.low_half,AX}
  649.      /$83/$16/>pxl_ptr+2/$00 {ADC pxl_ptr.high_half,+00}
  650.      );
  651.      end; {copy rows}
  652.   writeln;
  653.   end {if char};
  654. end;
  655.  
  656. procedure write_pxl_dir(char_no: integer);
  657. begin
  658.    with pxl_dir[char_no] do begin;
  659.       writear(pxlfile, pxl_width, 2);
  660.       writear(pxlfile, pxl_height, 2);
  661.       writear(pxlfile, x_offset, 2);
  662.       writear(pxlfile, y_offset, 2);
  663.       writear(pxlfile, pointer, 4);
  664.       writear(pxlfile, tfm_width, 4);
  665.       end;
  666.    end;
  667.  
  668. procedure init_pl_file;
  669. var
  670.    space_width, x_height: real;
  671. begin
  672.    writeln(plfile,'(COMMENT THIS PL FILE WAS PRODUCED BY HP2TEX)');
  673.    writeln(plfile,'(FAMILY HPSOFT)');
  674.    writeln(plfile,'(DESIGNSIZE D ', design_size, ')');
  675.    writeln(plfile,'(COMMENT DESIGNSIZE IS IN POINTS)');
  676.    writeln(plfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
  677.    writeln(plfile,'(CHECKSUM O 0)');
  678.    writeln(plfile,'(SEVENBITSAFEFLAG TRUE)');
  679.    writeln(plfile,'(CODINGSCHEME ASCII)');
  680.    writeln(plfile,'(FONTDIMEN');
  681.  
  682.    if font1.fixed=1 then begin
  683.        {if there is a space char (ascii 32), use its width +50% -33%
  684.        as the space stretch and skip values.  Mext guess is based on
  685.        char x (ascii 120). If neither available, arbitrarily
  686.        use values of 1/2, 1/4 and 1/6 of design size}
  687.  
  688.       if pxl_dir[32].pxl_width<>0 then
  689.          space_width:=pxl_dir[32].radix_width*radix_scale
  690.       else if pxl_dir[120].radix_width<>0 then begin
  691.          writeln
  692.          ('Font contains no space, using x for stretch and shrink');
  693.         space_width:=pxl_dir[120].radix_width*radix_scale
  694.          end
  695.       else begin
  696.          writeln
  697.          ('Font contains no space or x, using 1/2 design size for font space');
  698.          space_width:=0.5 {half the design size}
  699.          end;
  700.       writeln(plfile,'   (SPACE R ',space_width:10:6,')');
  701.       writeln(plfile,'   (STRETCH R ',space_width/2:10:6, ')');
  702.       writeln(plfile,'   (SHRINK R ',space_width/3:10:6, ')');
  703.       writeln(plfile,'   (EXTRASPACE R ',space_width/3:10:6, ')');
  704.       end
  705.    else begin
  706.       space_width:=font1.pitch*radix_scale;
  707.       writeln(plfile,'   (SPACE R ',space_width:10:6,')');
  708.       writeln(plfile,'   (STRETCH R 0)');
  709.       writeln(plfile,'   (SHRINK R 0)');
  710.       writeln(plfile,'   (EXTRASPACE R ',space_width:10:6, ')');
  711.       end;
  712.    writeln(plfile,'   (QUAD R ',space_width*2:10:6, ')');
  713.  
  714.    {look in table for x to get height of x (char 120)}
  715.    if pxl_dir[120].pxl_height <> 0 then
  716.       x_height:=pxl_dir[120].pxl_height*dot_scale
  717.    else begin
  718.       x_height:=0.75;
  719.       writeln
  720.   ('This font contains no x, using 3/4 design size for x-height');
  721.       end;
  722.    writeln(plfile,'   (XHEIGHT R ',x_height:10:6,')');
  723.    writeln(plfile,'   )');
  724.    end;
  725.  
  726. procedure write_pl_entry(char_no: integer);
  727. var depth,italcorr:real;
  728. begin
  729.    with pxl_dir[char_no] do begin
  730.       writeln(plfile,'(CHARACTER D ', char_no);
  731.       writeln(plfile,'   (CHARWD R ',radix_width*radix_scale:10:6,')');
  732.       writeln(plfile,'   (CHARHT R ',y_offset*dot_scale:10:6,')');
  733.       italcorr:=(pxl_width*4-radix_width)*radix_scale;
  734.       if italcorr>0 then begin
  735.          if font1.style=1 then
  736.            writeln(plfile,'   (CHARIC R ',italcorr:10:6,')')
  737.          else
  738.            writeln('Warning: upright font has nonzero CHARIC');
  739.          end;
  740.       depth:=(pxl_height-y_offset)*dot_scale;
  741.       if depth>0 then
  742.          writeln(plfile,'   (CHARDP R ',depth:10:6,')');
  743.       writeln(plfile,'   )');
  744.       end;
  745.    end;
  746.  
  747. begin
  748.  
  749. hpbufptr:=2048;
  750. hpbuflen:=0;
  751. pxlbufptr:=1;
  752.  
  753. writeln('This is HP2TeX ver. 1.0');
  754. writeln;
  755. {Open the font file}
  756. filename:=paramstr(1);
  757. open_untyped_file
  758.    (hpfile, filename,'sfp','r','Enter name of HP soft font file: ');
  759.  
  760. read_fontheader;
  761.  
  762. ask_for_magn_and_design_size;
  763.  
  764. {Open the new pxl file}
  765. filename:=paramstr(2);
  766. open_untyped_file
  767.    (pxlfile, filename,'pxl','w','Enter name of pxl file to write: ');
  768.  
  769. {Open the new tfm file}
  770. filename:=paramstr(3);
  771. open_text_file(plfile, filename,'pl','w','Enter name of pl file to write: ');
  772.  
  773. {Write the id to the pxl file}
  774. writear(pxlfile, pxlheader,4);
  775. pxl_ptr.high_half:=0;
  776. pxl_ptr.low_half :=1; {longint 1}
  777.  
  778. {Initialize the pxl directory table to all zeros}
  779. fillchar(pxl_dir,2304,0);
  780.  
  781. char_code:=0;
  782. while (not (eof(hpfile)and(hpbufptr>=hpbuflen))) and (char_code <>-1) do
  783.   read_char(char_code);
  784.  
  785. if char_code=-1 then
  786.   writeln(
  787.   'This font file contains some junk at the end which I will ignore');
  788.  
  789. {Now we start the pl file work.}
  790. writeln('Starting on pl file and pxl directory');
  791.  
  792. init_pl_file;
  793. for i:=0 to 127 do begin
  794.    write_pxl_dir(i);
  795.    if pxl_dir[i].pxl_width<>0 then write_pl_entry(i);
  796.    end;
  797.  
  798.  
  799. {Finish up by writing a zero for the checksum (ignore checksum),
  800.  the magnification,
  801.  finally the design size times 2^20,
  802.  a pointer to the directory,
  803.  and the pxl header word}
  804.  
  805. writear(pxlfile, zero_word, 4);
  806. writear(pxlfile, magnification, 4);
  807. writear(pxlfile, designsize, 4);
  808. writear(pxlfile, pxl_ptr, 4);
  809. writear(pxlfile, pxlheader, 4);
  810.  
  811.  
  812. close(hpfile);
  813. closeout(pxlfile);
  814. close(plfile);
  815.  
  816. writeln('All done');
  817. end.
  818.  
  819. 
  820.